﻿Imports MapWinGIS
Imports System.ComponentModel

<Serializable()> Public Class ESCRoadLayer
    Inherits EditableShapeLayer


    Public Sub New(ByVal ln As String, ByVal tl As BaseTool)
        MyBase.New(ln, tl)

        Rwidth = 2
        bFill = 1

        fillLineclr = Drawing.Color.Black


    End Sub

    '这些都是为了讨厌的VB事件逻辑啊
    Protected Sub New( _
      ByVal info As System.Runtime.Serialization.SerializationInfo, _
      ByVal context As System.Runtime.Serialization.StreamingContext)

        MyBase.New(info, context)

    End Sub


    Dim Rwidth As Double
    Public Property RoadWidth() As Double
        Get
            Return Rwidth
        End Get
        Set(ByVal value As Double)
            If value > 0 Then
                Rwidth = value
            End If

        End Set
    End Property


    Protected Function BuildRectangleFromTPts(ByVal pt1 As MapWinGIS.Point, ByVal pt2 As MapWinGIS.Point) As MapWinGIS.Point()

        Dim pts(3) As MapWinGIS.Point

        Dim p1 As New MapWinGIS.Point
        Dim p2 As New MapWinGIS.Point
        Dim p3 As New MapWinGIS.Point
        Dim p4 As New MapWinGIS.Point

        If pt1.y = pt2.y And pt1.x = pt2.x Then


            Return Nothing

        End If

        If pt1.x = pt2.x And pt1.y <> pt2.y Then



            p1.x = pt1.x - Rwidth / 2
            p1.y = pt1.y

            p2.x = pt1.x + Rwidth / 2
            p2.y = pt1.y

            p3.x = pt2.x + Rwidth / 2
            p3.y = pt2.y

            p4.x = pt2.x - Rwidth / 2
            p4.y = pt2.y











        End If






        If pt1.y = pt2.y And pt1.x <> pt2.x Then

            p1.x = pt1.x
            p1.y = pt1.y - Rwidth / 2

            p2.x = pt1.x
            p2.y = pt1.y + Rwidth / 2

            p3.x = pt2.x
            p3.y = pt2.y + Rwidth / 2

            p4.x = pt2.x
            p4.y = pt2.y - Rwidth / 2



        End If

        If pt1.y <> pt2.y And pt1.x <> pt2.x Then

            Dim k As Double = (pt2.y - pt1.y) / (pt2.x - pt1.x)
            Dim kv As Double = -1 / k

            Dim thelta As Double = Math.Atan(kv)

            If thelta > 0 Then

                p1.x = pt1.x - Math.Cos(thelta) * Rwidth / 2
                p1.y = pt1.y - Math.Sin(thelta) * Rwidth / 2

                p2.x = pt1.x + Math.Cos(thelta) * Rwidth / 2
                p2.y = pt1.y + Math.Sin(thelta) * Rwidth / 2

                p3.x = pt2.x + Math.Cos(thelta) * Rwidth / 2
                p3.y = pt2.y + Math.Sin(thelta) * Rwidth / 2



                p4.x = pt2.x - Math.Cos(thelta) * Rwidth / 2
                p4.y = pt2.y - Math.Sin(thelta) * Rwidth / 2

            Else

                p1.x = pt1.x - Math.Cos(thelta) * Rwidth / 2
                p1.y = pt1.y - Math.Sin(thelta) * Rwidth / 2

                p2.x = pt1.x + Math.Cos(thelta) * Rwidth / 2
                p2.y = pt1.y + Math.Sin(thelta) * Rwidth / 2

                p3.x = pt2.x + Math.Cos(thelta) * Rwidth / 2
                p3.y = pt2.y + Math.Sin(thelta) * Rwidth / 2



                p4.x = pt2.x - Math.Cos(thelta) * Rwidth / 2
                p4.y = pt2.y - Math.Sin(thelta) * Rwidth / 2







            End If



        End If

        If Me.IsONLineLeft(pt1, pt2, p1) Then

            pts(0) = p2
            pts(1) = p1
            pts(2) = p4
            pts(3) = p3

        Else

            pts(0) = p1

            pts(1) = p2
            pts(2) = p3

            pts(3) = p4

        End If






        ''要想计算真正的集合关系，非向量是搞不定啦，cosA=a.b/|a|*|b|
        '如此美妙的算法用不上啦，悲哀啊，直接判断直线方程代入后的大小，就能判断左右了，网上说的

        'Dim uMod = Math.Sqrt((pt2.x - pt1.x) ^ 2 + (pt2.y - pt1.y) ^ 2)
        'Dim vMod = Math.Sqrt((p1.x - pt1.x) ^ 2 + (p1.y - pt1.y) ^ 2)

        'Dim uDotv As Double = (pt2.x - pt1.x) * (p1.x - pt1.x) + (pt2.y - pt1.y) * (p1.y - pt1.y)
        'Dim A As Double = Math.Acos(uDotv / (uMod * vMod))

        'If A > Math.PI Then


        'End If




        Return pts


    End Function

    Protected Function IsONLineLeft(ByVal pt1 As MapWinGIS.Point, ByVal pt2 As MapWinGIS.Point, ByVal pt As MapWinGIS.Point) As Boolean
        If pt1.y = pt2.y And pt1.x = pt2.x Then


            Return Nothing

        End If
        If pt2.x = pt1.x Then

            If pt2.y > pt1.y Then
                If pt.x > pt2.x Then
                    Return False
                Else
                    Return True
                End If
            Else

                If pt.x > pt2.x Then
                    Return True
                Else
                    Return False
                End If

            End If

        End If


        '      如果是矢量, 就用下面的
        '定义：平面上的三点P1(x1,y1),P2(x2,y2),P3(x3,y3)的面积量：   
        '                                    |x1     x2     x3|   
        '        S(P1,P2,P3)   =   |y1     y2     y3|   =   (x1-x3)*(y2-y3)   -   (y1-y3)(x2-x3)   
        '                                    |1       1       1   |   
        '当P1P2P3逆时针时S为正的，当P1P2P3顺时针时S为负的。   

        '令矢量的起点为A，终点为B，判断的点为C，   
        '      如果S（A，B，C）为正数，则C在矢量AB的左侧；   
        '      如果S（A，B，C）为负数，则C在矢量AB的右侧；   
        '      如果S（A，B，C）为0，则C在直线AB上。

        Dim s As Double = (pt1.x - pt.x) * (pt2.y - pt.y) - (pt1.y - pt.y) * (pt2.x - pt.x)
        If s > 0 Then
            Return True

        Else

            Return False

        End If


    End Function

    Protected Function Get2LineCrossPoint(ByVal pt1 As MapWinGIS.Point, ByVal pt2 As MapWinGIS.Point, ByVal pt3 As MapWinGIS.Point, ByVal pt4 As MapWinGIS.Point) As MapWinGIS.Point
        If pt1.y = pt2.y And pt1.x = pt2.x Then


            Return Nothing

        End If

        If pt3.y = pt4.y And pt3.x = pt4.x Then


            Return Nothing

        End If


        Dim ptReturn As New MapWinGIS.Point

        '要想计算斜率，那么直线的角度不能是90度
        If pt2.x = pt1.x And pt3.x <> pt4.x Then

            Dim k2 As Double = (pt4.y - pt3.y) / (pt4.x - pt3.x)
            Dim b2 As Double = pt4.y - k2 * (pt4.x)

            ptReturn.x = pt2.x
            ptReturn.y = k2 * ptReturn.x + b2

            Return ptReturn

        End If

        If pt3.x = pt4.x And pt2.x <> pt1.x Then


            Dim k1 As Double = (pt2.y - pt1.y) / (pt2.x - pt1.x)
            Dim b1 As Double = pt2.y - k1 * (pt2.x)

            ptReturn.x = pt4.x
            ptReturn.y = k1 * ptReturn.x + b1

            Return ptReturn


        End If

        If pt3.x <> pt4.x And pt2.x <> pt1.x Then

            Dim k1 As Double = (pt2.y - pt1.y) / (pt2.x - pt1.x)
            Dim b1 As Double = pt2.y - k1 * (pt2.x)

            Dim k2 As Double = (pt4.y - pt3.y) / (pt4.x - pt3.x)
            Dim b2 As Double = pt4.y - k2 * (pt4.x)



            ptReturn.x = (b2 - b1) / (k1 - k2)
            ptReturn.y = ptReturn.x * k1 + b1

            Return ptReturn

        End If


        Return Nothing


    End Function

    Protected Function BuildRoadPoints(ByVal pts As MapWinGIS.Point()) As MapWinGIS.Point()
        Dim pt1 As MapWinGIS.Point
        Dim pt2 As MapWinGIS.Point
        Dim pt3 As MapWinGIS.Point

        Dim n = pts.Length

        ' Dim ptsReturn As 


        Dim pForward As New List(Of MapWinGIS.Point)
        Dim pBackward As New List(Of MapWinGIS.Point)



        Dim pTemp As MapWinGIS.Point()

        Dim pTemp2 As MapWinGIS.Point() '这个用于描述第二个直线点

        Dim pFt As MapWinGIS.Point
        Dim pBt As MapWinGIS.Point

        Dim pOkF As MapWinGIS.Point
        Dim pOkB As MapWinGIS.Point


        For i As Integer = 0 To pts.Length - 2

            If i = n - 2 Then

                pt1 = pts(i)
                pt2 = pts(i + 1)



                pTemp = Me.BuildRectangleFromTPts(pt1, pt2)

                If i = 0 Then

                    pForward.Add(pTemp(1))

                    pBackward.Add(pTemp(0))
                End If


                pForward.Add(pTemp(2))


                pBackward.Add(pTemp(3))


            End If

            If i < n - 2 Then

                pt1 = pts(i)
                pt2 = pts(i + 1)
                pt3 = pts(i + 2)


                pTemp = Me.BuildRectangleFromTPts(pt1, pt2)

                If i = 0 Then

                    pForward.Add(pTemp(1))

                    pBackward.Add(pTemp(0))

                End If




                pTemp2 = Me.BuildRectangleFromTPts(pt2, pt3)

                'pOkF = New MapWinGIS.Point
                'pOkF.x = (pTemp(2).x + pTemp2(1).x) / 2
                'pOkF.y = (pTemp(2).y + pTemp2(1).y) / 2

                pOkF = Me.Get2LineCrossPoint(pTemp(1), pTemp(2), pTemp2(1), pTemp2(2))


                'pOkB = New MapWinGIS.Point
                'pOkB.x = (pTemp(3).x + pTemp2(0).x) / 2
                'pOkB.y = (pTemp(3).y + pTemp2(0).y) / 2


                pOkB = Me.Get2LineCrossPoint(pTemp(0), pTemp(3), pTemp2(0), pTemp2(3))

                pForward.Add(pOkF)


                pBackward.Add(pOkB)


            End If















        Next



        pBackward.Reverse()
        pForward.AddRange(pBackward)


        Dim pReturn(pForward.Count - 1) As MapWinGIS.Point

        For i As Integer = 0 To pForward.Count - 1

            pReturn(i) = pForward.Item(i)


        Next



        Return pReturn

    End Function



    Public Overrides Function AddEntity(ByVal sn As String, ByVal ptlist() As MapWinGIS.Point, ByVal desc As String) As Integer

        If ptlist.Length < 2 Then
            Return -1
        End If


        '关键节点，呵呵
        Dim en As New FEntity(sn, ptlist, desc)
        dicKeyPts.Add(sn, en)




        Dim pReturn As MapWinGIS.Point()
        pReturn = Me.BuildRoadPoints(ptlist)




        '增加封边点，使成为封闭的多边形

        Dim nl As Integer = pReturn.Length


        ReDim Preserve pReturn(nl)

        pReturn(nl) = pReturn(0)




        Dim sfPoly As Shapefile = mapwin.get_GetObject(m_iLayer)



        sfPoly.StartEditingShapes(True)





        Dim shp As New Shape
        shp.ShapeType = ShpfileType.SHP_POLYGON
        Dim ptIndex As Integer = 0

        Dim n As Integer = pReturn.Length



        For i As Integer = 1 To n

            shp.InsertPoint(pReturn(i - 1), ptIndex)


        Next




        Dim shpIndex As Integer = sfPoly.NumShapes

        sfPoly.EditInsertShape(shp, shpIndex)

        sfPoly.EditCellValue(0, shpIndex, sn)
        sfPoly.EditCellValue(1, shpIndex, desc)

        sfPoly.StopEditingShapes()





        Me.DrawText()


        mapwin.Redraw()

        Return shpIndex




    End Function

    Public Overrides Sub AddEntityRange(ByVal lst As System.Collections.Generic.List(Of FEntity))

        For Each en As FEntity In lst

            dicKeyPts.Add(en.sn, en)
        Next



        Dim ptlist As MapWinGIS.Point()
        Dim sn As String
        Dim desc As String

        Dim sfPoly As MapWinGIS.Shapefile = mapwin.get_GetObject(m_iLayer)



        sfPoly.StartEditingShapes(True)



        For Each en As FEntity In lst



            sn = en.sn
            ptlist = en.ptlist
            desc = en.desc


            If ptlist.Length < 2 Then

            Else


                Dim pReturn As MapWinGIS.Point()
                pReturn = Me.BuildRoadPoints(ptlist)




                '增加封边点，使成为封闭的多边形

                Dim nl As Integer = pReturn.Length


                ReDim Preserve pReturn(nl)

                pReturn(nl) = pReturn(0)










                Dim shp As New Shape
                shp.ShapeType = ShpfileType.SHP_POLYGON
                Dim ptIndex As Integer = 0

                Dim n As Integer = pReturn.Length



                For i As Integer = 1 To n

                    shp.InsertPoint(pReturn(i - 1), ptIndex)


                Next




                Dim shpIndex As Integer = sfPoly.NumShapes

                sfPoly.EditInsertShape(shp, shpIndex)

                sfPoly.EditCellValue(0, shpIndex, sn)
                sfPoly.EditCellValue(1, shpIndex, desc)





            End If





        Next

        sfPoly.StopEditingShapes()


        '由于新增加了对象，所以需要根据现有状态，对对象操作

        Me.DrawText()

        mapwin.Redraw()



    End Sub

    Public Overrides Sub InitNewLayer(ByRef m As AxMapWinGIS.AxMap, ByVal OutPath As String)
        Dim sf As New Shapefile
        Dim strPath(2) As String




        sf.CreateNew("", MapWinGIS.ShpfileType.SHP_POLYGON)




        Dim f As New Field

        f = New Field
        f.Name = "Name"
        f.Type = FieldType.STRING_FIELD
        f.Width = 50

        Dim fd As New Field

        fd = New Field
        fd.Name = "desc"
        fd.Type = FieldType.STRING_FIELD
        fd.Width = 50

        sf.StartEditingShapes(True)
        sf.EditInsertField(f, 0)
        sf.EditInsertField(fd, 1)

        sf.StopEditingShapes(True, True)


        '加入载入的逻辑

        Dim strSave As String = OutPath + lname + ".shp"

        strPath(0) = OutPath + lname + ".shp"
        strPath(1) = OutPath + lname + ".dbf"
        strPath(2) = OutPath + lname + ".shx"

        For i As Integer = 0 To strPath.Length - 1
            If System.IO.File.Exists(strPath(i)) Then
                Try
                    System.IO.File.SetAttributes(strPath(i), IO.FileAttributes.Normal)
                    System.IO.File.Delete(strPath(i))
                Catch ex As Exception

                End Try

            End If
        Next

        Dim bS As Boolean = sf.SaveAs(strSave)

        If Not bS Then
            System.Windows.Forms.MessageBox.Show(lname + "文件创建失败！，请查看电脑软件使用权限")

        End If

        fname = strSave

        Me.InitLayer(m)

    End Sub

    Public Overrides Sub InitProp()

        OnFlColorChanged()
        onFlTypeChanged()
        OnBFlChanged()


    End Sub



    '填充相关
#Region "填充相关"

    Protected fillColor As Drawing.Color
    <CategoryAttribute("外观设置"), _
 DisplayName("填充颜色")> _
  Public Property FillColorProperty() As Drawing.Color
        Get
            Return fillColor
        End Get
        Set(ByVal value As Drawing.Color)
            fillColor = value
            OnFlColorChanged()
        End Set
    End Property
    Protected Sub OnFlColorChanged()

        Dim ucl As UInt32 = RGB(fillColor.R, fillColor.G, fillColor.B)
        mapwin.set_ShapeLayerFillColor(m_iLayer, ucl)

    End Sub

    Protected filltype As FtkFillStipple
    <CategoryAttribute("外观设置"), _
 DisplayName("填充类型")> _
  Public Property FilltypeProperty() As FtkFillStipple
        Get
            Return filltype
        End Get
        Set(ByVal value As FtkFillStipple)
            filltype = value
            onFlTypeChanged()
        End Set
    End Property
    Protected Sub onFlTypeChanged()

        Dim temp As MapWinGIS.tkFillStipple = Me.getFillType(filltype)
        mapwin.set_ShapeLayerFillStipple(m_iLayer, temp)

    End Sub

    Dim bFill As Boolean
    <CategoryAttribute("外观设置"), _
 DisplayName("是否填充")> _
  Public Property BFillProperty() As Boolean
        Get
            Return bFill
        End Get
        Set(ByVal value As Boolean)
            bFill = value
            OnBFlChanged()
        End Set
    End Property

    Protected Sub OnBFlChanged()
        mapwin.set_ShapeLayerDrawFill(m_iLayer, bFill)
    End Sub


    Protected fillLineclr As Drawing.Color
    <CategoryAttribute("外观设置"), _
 DisplayName("填充线条颜色")> _
    Public Property FillLineTypeProperty() As Drawing.Color
        Get
            Return fillLineclr
        End Get
        Set(ByVal value As Drawing.Color)
            If fillLineclr = value Then
            Else
                fillLineclr = value
                Me.OnFillLineColorChanged()
            End If
        End Set
    End Property

    Protected Sub OnFillLineColorChanged()

        Dim ucl As UInt32 = RGB(fillLineclr.R, fillLineclr.G, fillLineclr.B)

        mapwin.set_ShapeLayerStippleColor(m_iLayer, ucl)
    End Sub




#End Region

End Class
